BBS in a Box 3/BBS in a box - Trilogy III.iso/Files/Tele/Pete Johnson/Tally 2.2<source> Folder/Tally.p

Text File | 1991-06-29 | 25.4 KB | 897 lines | [TEXT/PJMM]

program Tally;

{     Written by Pete Johnson for the    Glassell Park BBS                        }

{    Version History                                                                    }
{    --------------                                                                    }
{    1.4    6/29/89                                                                    }
{    1.5    11/19/89    Added WaitNextEvent in HelloTabby for MF            }
{                            compatibility.                                            }
{    2.0    2/3/90        Replaced LS Pascal file functions with Toolbox        }
{                            calls.                                                        }
{    2.1    5/23/90        Tally would not work if Tally Data file did not        }
{                            exist -- fixed.                                            }
{    2.2    6/28/91        Tally was getting stuck in an endless loop while    }
{                            reading MSGHDR and could not cope with Config    }
{                            file that was bigger than old SS size -- fixed.        }
{                            Also added SIZE resource.                                }

{    This program counts messages in each section posted during the        }
{    last 10 days.                                                                        }

    uses
        Globals, HelloTabby;

    label
        999;

    const
        DAYSECS = 86400;        {    There are 86400 seconds in a 24-hour day            }
        VERSION = '2.2';

    type
        DateTimeRecord = packed array[1..6] of char;

        Header = record
                Status: packed array[1..2] of byte;    {    use Status[1] only    }
                MsgNo: longint;
                Section: packed array[1..2] of byte;    {    use Section[1] only    }
                TimeRcvd: DateTimeRecord;
                MsgFrom: string[31];
                MsgTo: string[31];
                MsgSubject: string[41];
                Destination: string[67];
                BeginText: longint;
                LengthText: longint;
                ReplyTo: longint;
                TimeSent: DateTimeRecord
            end;

    var
        ThisHeader: Header;
        Echoes, PrivNet: packed array[1..255] of boolean;
        SectionCount: array[1..255, 1..10] of integer;
        StoredCount: array[1..255, 1..10] of longint;
        SectionName: array[1..255] of string[25];
        OmitSection: array[1..255] of boolean;
        Done: boolean;
        PathAndLogfile, PathAndIntro, PathAndStep, OmitFile, IntroLine, TallyData: STR255;
        MsgPath, Ms, TempString, HiMsgStr: STR255;
        SectionString, TheFileName, MESSAGESPath, TheExportFile: STR255;
        Security, Modifier, Restriction, SectionType, ThisSection, ThisDay, DebugRef: integer;
        ThisPub, ThisPriv, ThisStatus, HiBound, LoBound, Range, Increment, TheCursor: integer;
        LowMsg, HiMsg, MSGTXTLength, NowSecs, ThenSecs, RcvdSecs, Adjust: longint;
        DayMarker: array[1..10] of longint;
        WhenRcvdString: DateTimeRecord;
        TempTime, NowDateRec: DateTimeRec;
        ResHandle2: Handle;
        EchoFlag, HiMsgFlag, DeleteFlag: boolean;
        DialogPointer: DialogPtr;
        ACursorHandle: CursHandle;
        ACursor: Cursor;


{-----------------------------------------------------------------                            }
{ FrameDItem draws a round cornered rectangle around the item rectangle of a given item     }
{ in a given dialog. This is usually done to indicate the default choice button of a dialog.            }
{-----------------------------------------------------------------                            }

    procedure FrameDItem (dLog: DialogPtr; iNum: integer);

        var
            iBox: Rect;
            iType: integer;
            iHandle: Handle;
            oldPenState: PenState;

    begin
        GetPenState(oldPenState);
        GetDItem(dLog, iNum, iType, iHandle, iBox);
        InsetRect(iBox, -4, -4);
        PenSize(3, 3);
        FrameRoundRect(iBox, 16, 16);
        SetPenState(oldPenState)
    end;

{ ------------------------------------------------------ }

    function AtEOF (fRefNum: Integer): Boolean;
        var
            currPos, eofPos: LongInt;

    begin
        Err := GetFPos(fRefNum, currPos);
        Err := GetEOF(fRefNum, eofPos);
        AtEOF := currPos = eofPos
    end;

{ ------------------------------------------------------ }

    function Wr (FileRefNum: integer; TheMessage: string): OSErr;

{    Writes string (without length byte) to text file, returns error code    }

        var
            TheLength: longint;

    begin
        TheLength := length(TheMessage);
        Wr := FSWrite(FileRefNum, TheLength, Pointer(ord(@TheMessage) + 1));
    end;

{-----------------------------------------------------------------    }

    function WrLn (FileRefNum: integer; TheMessage: string): OSErr;

{    Writes string (without length byte) to text file, returns error code    }

    begin
        TheMessage := concat(TheMessage, ENDLINE);
        WrLn := Wr(FileRefNum, TheMessage);
    end;

{-----------------------------------------------------------------    }

    function ReadLine (FileRefNum: integer; var TheMessage: string): OSErr;

        var
            myPB: ParamBlockRec;
            myString: STR255;

    begin
        myString := '';
        myPB.ioCompletion := nil;
        myPB.ioRefNum := FileRefNum;
        myPB.ioBuffer := Pointer(@TheMessage[1]);
        myPB.ioReqCount := 255;
        myPB.ioPosMode := 3456; {ASCII 13*256+128}
        myPB.ioPosOffset := 0; {ignored}
        ReadLine := PBRead(@myPB, False);
        TheMessage[0] := Char(myPB.ioActCount - 1); {Drop CR}
    end;

{-----------------------------------------------------------------    }

    procedure SkipBlanks (fRef: integer);

{    Skips blanks until eof or a nonblank is found    }

        var
            currPos, HowMuch: longint;
            TheChar: char;

    begin
        TheChar := space;
        HowMuch := 1;
        while ((TheChar = SPACE) | (TheChar = TAB) | (TheChar = ENDLINE)) & (not AtEOF(fRef)) do
            begin
                Err := FSRead(fRef, HowMuch, @TheChar);
            end;
        Err := GetFPos(fRef, currPos);
        if currPos > 0 then
            Err := SetFPos(fRef, fsAtMark, -1);
    end;

{-----------------------------------------------------------------    }

    function ReadData (fRef: integer): longint;

{    Skips blanks until eof or a nonblank is found, then reads until eof or a blank is found     and converts to integer}

        var
            currPos, HowMuch, TempLong: longint;
            TheChar: char;
            TempString: str255;

    begin
        TempString := '';
        TheChar := space;
        HowMuch := 1;
        while ((TheChar = SPACE) | (TheChar = TAB) | (TheChar = ENDLINE)) & (not AtEOF(fRef)) & (Err = NoErr) do
            begin
                Err := FSRead(fRef, HowMuch, @TheChar);
            end;
        if (not AtEOF(fRef)) then
            begin
                Err := GetFPos(fRef, currPos);
                if currPos > 0 then
                    Err := SetFPos(fRef, fsAtMark, -1);
                while ((TheChar <> SPACE) | (TheChar <> TAB) | (TheChar <> ENDLINE)) & (not AtEOF(fRef)) & (Err = NoErr) do
                    begin
                        Err := FSRead(fRef, HowMuch, @TheChar);
                        TempString := concat(TempString, TheChar)
                    end;
                StringToNum(TempString, TempLong);
                ReadData := TempLong;
            end        {    if (not AtEOF(fRef))        }
        else
            ReadData := 0;
    end;

{-----------------------------------------------------------------    }

    procedure RotateCursorBall;

    begin
        Increment := 1;
        ACursorHandle := GetCursor(TheCursor);
        SetCursor(ACursorHandle^^);
        if TheCursor > 130 then
            TheCursor := 128
        else
            TheCursor := TheCursor + 1;
    end;

{-----------------------------------------------------------------    }

    function MakeTime (Index: integer; Separator: char): string;

{ Function changes three chars of DateTimeRecord to formatted time or date string    }

        var
            MakeTimeString, LocalTemp: STR255;

    begin
        LocalTemp := '';
        NumToString(ord(WhenRcvdString[Index + 1]), LocalTemp);
        if length(LocalTemp) = 1 then
            LocalTemp := concat('0', LocalTemp);
        MakeTimeString := concat(LocalTemp, Separator);
        NumToString(ord(WhenRcvdString[Index + 2]), LocalTemp);
        if length(LocalTemp) = 1 then
            LocalTemp := concat('0', LocalTemp);
        MakeTimeString := concat(MakeTimeString, LocalTemp, Separator);
        NumToString(ord(WhenRcvdString[Index + 3]), LocalTemp);
        if length(LocalTemp) = 1 then
            LocalTemp := concat('0', LocalTemp);
        MakeTime := concat(MakeTimeString, LocalTemp)
    end;

{ ------------------------------------------------------ }

    function Make2Digits (ConvertFrom: string): integer;

{    Converts two-character string into an ascii value        }

        var
            Num1, Num2: integer;

    begin
        Num1 := ord(ConvertFrom[1]) - ord('0');
        Num2 := ord(ConvertFrom[2]) - ord('0');
        Make2Digits := Num2 + (Num1 * 10)
    end;

{ ------------------------------------------------------ }

    procedure ReadConfig;

        var
            ConfigRefNum: integer;
            CharsToSend: longint;
            AString: str255;

    begin
        AString := '';
        MESSAGESPath := '';
        Err := FSOpen(concat(gDefaultPath, 'Config'), vRefNum, ConfigRefNum);
        if Err = noErr then
            begin
                CharsToSend := 80;
                if Err = noErr then
                    Err := SetFPos(ConfigRefNum, fsFromStart, 139);
                if Err = noErr then
                    Err := FSRead(ConfigRefNum, CharsToSend, @AString);
                if length(AString) > 0 then
                    MESSAGESPath := AString;
                MESSAGESPath := concat(MESSAGESPath, ':MESSAGES');
                if Err = noErr then
                    Err := FSClose(ConfigRefNum)
            end;
        if Err <> NoErr then
            goto 999;
    end;

{ ------------------------------------------------------ }

    procedure ReadMESSAGES;

{ Procedure reads the MESSAGES file                                }

        type
            AString = string;
            AStringPtr = ^AString;
            AStringHdl = ^AStringPtr;
            ALongint = Longint;
            ALongintPtr = ^ALongint;
            ALongintHdl = ^ALongintPtr;

        var
            MSCount, MSGRefNum: integer;
            MSChar, OneChar: char;
            MsgStringHandle: AStringHdl;
            MsgLongintHandle: ALongintHdl;
            CharsToSend: longint;

    begin
        MsgPath := '';
        MsgStringHandle := AStringHdl(NewHandle(sizeOf(AString)));
        MsgLongintHandle := ALongintHdl(NewHandle(sizeOf(ALongint)));
        CharsToSend := 255;
        Err := FSOpen(MESSAGESPath, vRefNum, MSGRefNum);
        Err := FSRead(MSGRefNum, CharsToSend, Ptr(MsgStringHandle^));
        MsgPath := concat(MsgStringHandle^^, ':');

        CharsToSend := 4;
        Err := SetFPos(MSGRefNum, fsFromStart, 50);
        Err := FSRead(MSGRefNum, CharsToSend, Ptr(MsgLongintHandle^));
        LowMsg := MsgLongintHandle^^;
        Err := FSRead(MSGRefNum, CharsToSend, Ptr(MsgLongintHandle^));
        HiMsg := MsgLongintHandle^^;

        for MSCount := 1 to 255 do
            begin
                Err := SetFPos(MSGRefNum, fsFromStart, (62 + (MSCount - 1) * 36));
                CharsToSend := 255;
                Err := FSRead(MSGRefNum, CharsToSend, Ptr(MsgStringHandle^));
                SectionName[MSCount] := MsgStringHandle^^;

            end;        {    for MSCount := 1 to 255 do    }

        DisposHandle(Handle(MsgStringHandle));
        DisposHandle(Handle(MsgLongintHandle));
        Err := FSClose(MSGRefNum);
    end;

{ ------------------------------------------------------ }

    procedure MakeTextFile (FileName: string);

{ Sets up QUED-compatible text  file                                }

        var
            fndrInfo: FInfo;

    begin
        Err := GetFInfo(FileName, vRefNum, fndrInfo);
        if Err = noErr then
            begin
                fndrInfo.fdType := 'TEXT';
                fndrInfo.fdCreator := 'QED1';
                Err := SetFInfo(FileName, vRefNum, fndrInfo);
            end
        else
            Err := Create(FileName, vRefNum, 'QED1', 'TEXT');
    end;

{ ------------------------------------------------------ }

    procedure MakeSeconds (Convert: DateTimeRecord);

        var
            Temp: DateTimeRec;

    begin
        with Temp do
            begin
                Month := ord(Convert[1]);
                Day := ord(Convert[2]);
                Year := ord(Convert[3]) + 1900;
                Hour := 0;
                Minute := 0;
                Second := 0;
            end;
        Date2Secs(Temp, RcvdSecs);

    end;

{ ------------------------------------------------------ }
    function theFilePos (FRef: integer): longint;

        var
            CurrentLoc: longint;

    begin
        Err := GetFPos(FRef, CurrentLoc);
        theFilePos := CurrentLoc;
    end;
{ ------------------------------------------------------ }

    procedure ProcessMSGHDR;

{ Processes MSGHDR file                                }

        const
            HeaderSize = SizeOf(Header);

        var
            Count1, Count2, DayCount, MsgHdrRef: integer;
            LastMsgNo, HowMuch: longint;

    begin
        for Count1 := 1 to 255 do
            for Count2 := 1 to 10 do
                SectionCount[Count1, Count2] := 0;
        for DayCount := 1 to 10 do
            DayMarker[DayCount] := HiMsg;
        ThenSecs := NowSecs - (10 * DAYSECS);
        Secs2Date(ThenSecs, TempTime);            {    Get the date 10 days ago                                        }
        with TempTime do                                {    Set the time to the start of that day                            }
            begin
                Hour := 0;
                Minute := 0;
                Second := 0;
            end;
        Date2Secs(TempTime, ThenSecs);            {    We now have the lower bound for qualifying messages    }
        Done := false;
        TheFileName := concat(MsgPath, 'MSGHDR');
        Err := FSOpen(TheFileName, vRefNum, MsgHdrRef);
        Err := SetFPos(MsgHdrRef, fsFromLEOF, 0);
        DayCount := 1;
        LastMsgNo := HiMsg;
        Increment := 5;
        while (theFilePos(MsgHdrRef) >= HeaderSize) & (not Done) & (Err = NoErr) do
            begin
                if Increment > 4 then
                    RotateCursorBall
                else
                    Increment := succ(Increment);
                HowMuch := HeaderSize;
                if (theFilePos(MsgHdrRef) >= HowMuch) then
                    Err := SetFPos(MsgHdrRef, fsFromStart, theFilePos(MsgHdrRef) - HowMuch);
                Err := FSRead(MsgHdrRef, HowMuch, @ThisHeader);
                with ThisHeader do
                    begin
                        ThisStatus := Status[1];                {    use 'good' byte                }
                        ThisSection := Section[1];                {    use 'good' byte                }
                        MakeSeconds(TimeRcvd);                {    returns RcvdSecs            }
                        if (BitAnd(1, ThisStatus) = 0) then                            {    Not deleted                                    }
                            if (ThisSection > 0) & (ThisSection < 256) then            {    Make sure it's a valid section number    }
                                if SectionName[ThisSection] <> '' then                    {    Make sure it's a defined section             }
                                    if (RcvdSecs > ThenSecs) then
                                        begin
                                            ThisDay := 11 - ((RcvdSecs - ThenSecs) div 86400);
                                            while DayCount < ThisDay do
                                                begin
                                                    DayMarker[DayCount] := LastMsgNo;
                                                    DayCount := DayCount + 1;
                                                end;
                                            LastMsgNo := MsgNo;
                                            SectionCount[ThisSection, ThisDay] := SectionCount[ThisSection, ThisDay] + 1
                                        end        {    if (RcvdSecs > ThenSecs)    }
                                    else
                                        begin
                                            Done := true;
                                            DayMarker[10] := LastMsgNo;
                                        end;
                    end;                    {    with ThisHeader                    }
                Err := SetFPos(MsgHdrRef, fsFromStart, theFilePos(MsgHdrRef) - HowMuch);
            end;                        {    while (filepos(MSGHDR) > 0)    }
        Err := FSClose(MsgHdrRef);
    end;                            {    procedure                            }

{ ------------------------------------------------------ }

    procedure WriteReport;

{ Procedure writes report with message counts    }

        var
            Count1, Count2, TheTotal, MLogRef, IntroRef, StepRef: integer;
            DayTotals: array[1..10] of integer;
            AM: boolean;
            DateStamp, TempDate: str255;

    begin
        for Count1 := 1 to 10 do
            DayTotals[Count1] := 0;
        Err := FSDelete(PathAndLogfile, vRefNum);
        MakeTextFile(PathAndLogfile);
        Err := FSOpen(PathAndLogfile, vRefNum, MLogRef);
        Err := WrLn(MLogRef, '');
        Err := WrLn(MLogRef, '                            Message Activity Report ');
        Err := Wr(MLogRef, '                         Prepared ');
        with NowDateRec do
            begin

                if month < 10 then
                    DateStamp := stringof(month : 1)
                else
                    DateStamp := stringof(month : 2);

                DateStamp := concat(DateStamp, '/');

                if day < 10 then
                    TempDate := stringof(day : 1)
                else
                    TempDate := stringof(day : 2);

                DateStamp := concat(DateStamp, TempDate, '/', stringof((year - 1900) : 2), ' at ');

                if hour >= 12 then
                    begin
                        AM := false;
                        if hour > 12 then
                            hour := hour - 12;
                    end
                else
                    AM := true;
                if hour < 10 then
                    TempDate := stringof(hour : 1)
                else
                    TempDate := stringof(hour : 2);

                DateStamp := concat(DateStamp, TempDate, ':');

                if minute < 10 then
                    TempDate := concat('0', stringof(hour : 1))
                else
                    TempDate := stringof(minute : 2);

                DateStamp := concat(DateStamp, TempDate);

                if AM then
                    DateStamp := concat(DateStamp, ' a.m.')
                else
                    DateStamp := concat(DateStamp, ' p.m.');

                Err := WrLn(MLogRef, DateStamp);

            end;        {    with NowDateRec do    }

        Err := WrLn(MLogRef, '');

        if PathAndIntro <> '' then
            begin
                Err := FSOpen(PathAndIntro, vRefNum, IntroRef);
                if Err = NoErr then
                    while not AtEOF(IntroRef) do
                        begin
                            Err := ReadLine(IntroRef, IntroLine);
                            Err := WrLn(MLogRef, IntroLine)
                        end;
                Err := FSClose(IntroRef);
                Err := WrLn(MLogRef, '')
            end;

        Err := WrLn(MLogRef, 'Message             ---------------------- Days Ago ------------------ ');
        Err := WrLn(MLogRef, 'Section             Today    1    2    3    4    5    6    7    8    9    Avg');
        Err := WrLn(MLogRef, '-----------------------------------------------------------------------------');
        for Count1 := 1 to 255 do
            begin
                if Increment > 4 then
                    RotateCursorBall
                else
                    Increment := Increment + 1;
                if (SectionName[Count1] <> '') and not OmitSection[Count1] then
                    begin
                        SectionName[Count1] := concat(SectionName[Count1], '                    ');        {    Pad section name with 20 blanks        }
                        Err := Wr(MLogRef, copy(SectionName[Count1], 1, 20));                            {     Keep section names < 21 characters    }
                        TheTotal := 0;
                        for Count2 := 1 to 10 do
                            begin
                                if ((Count2 - Adjust) > 0) then        {    Don't do this unless we're within bounds    }
                                    if SectionCount[Count1, Count2] < StoredCount[Count1, Count2 - Adjust] then
                                        SectionCount[Count1, Count2] := StoredCount[Count1, Count2 - Adjust];
                                DayTotals[Count2] := DayTotals[Count2] + SectionCount[Count1, Count2];
                                TheTotal := TheTotal + SectionCount[Count1, Count2];
                                Err := Wr(MLogRef, stringof(SectionCount[Count1, Count2] : 5));
                            end;        {    Count2 := 1 to 10    }
                        if (TheTotal mod 10) > 4 then
                            TheTotal := TheTotal + 5;
                        Err := Wr(MLogRef, stringof((TheTotal div 10) : 7));
                        Err := WrLn(MLogRef, '');
                    end;        {    SectionName[Count1] <> ''    }
            end;        {    Count1 := 1 to 255    }
        TheTotal := 0;
        Err := WrLn(MLogRef, '');
        Err := Wr(MLogRef, 'Daily Totals        ');
        for Count1 := 1 to 10 do
            begin
                Err := Wr(MLogRef, stringof(DayTotals[Count1] : 5));
                TheTotal := TheTotal + DayTotals[Count1];
            end;
        if (TheTotal mod 10) > 4 then
            TheTotal := TheTotal + 5;
        Err := Wr(MLogRef, stringof((TheTotal div 10) : 7));
        Err := WrLn(MLogRef, '');
        Err := FSClose(MLogRef);

        Err := FSDelete(PathAndStep, vRefNum);
        MakeTextFile(PathAndStep);
        Err := FSOpen(PathAndStep, vRefNum, StepRef);
        Err := WrLn(StepRef, '');
        Err := WrLn(StepRef, '     Message Numbers By Days Ago');
        Err := WrLn(StepRef, '');
        Err := WrLn(StepRef, 'Use this table to read messages you might');
        Err := WrLn(StepRef, 'have missed. To see all messages posted in');
        Err := WrLn(StepRef, 'the last two days, just read forward from');
        Err := WrLn(StepRef, 'the second message number in this list.');
        Err := WrLn(StepRef, '');
        Err := WrLn(StepRef, '             Day / Msg No');
        Err := WrLn(StepRef, '             ------------');
        for Count1 := 1 to 10 do
            Err := WrLn(StepRef, concat('             ', stringof(Count1 : 2), ' --', stringof(DayMarker[Count1] : 7)));
        Err := FSClose(StepRef)
    end;

{ ------------------------------------------------------ }

    procedure HandleDialog;

        var
            theDialog: DialogPtr;
            ItemHit, itemType, whichItem: integer;
            itemHandle: Handle;
            dispRect: Rect;
            thisButton: ControlHandle;

        const
            disableItem = 128;

    begin
        paramText(VERSION, '', '', '');
        InitCursor;
        theDialog := GetNewDialog(1002, nil, POINTER(-1));                {IM I-413}
        SetPort(theDialog);
        FrameDItem(theDialog, OK);
        DrawDialog(theDialog);

        NextLaunch := GetString(500)^^;

        getDItem(theDialog, 3, itemType, itemHandle, dispRect);
        SetIText(Handle(itemHandle), NextLaunch);

        getDItem(theDialog, 4, itemType, itemHandle, dispRect);
        SetIText(Handle(itemHandle), PathAndLogfile);

        getDItem(theDialog, 5, itemType, itemHandle, dispRect);
        SetIText(Handle(itemHandle), PathAndIntro);

        getDItem(theDialog, 6, itemType, itemHandle, dispRect);
        SetIText(Handle(itemHandle), PathAndStep);

        getDItem(theDialog, 7, itemType, itemHandle, dispRect);
        SetIText(Handle(itemHandle), OmitFile);

        getDItem(theDialog, 8, itemType, itemHandle, dispRect);
        SetIText(Handle(itemHandle), TallyData);

        if StillDown then
            repeat
            until not Button;
        repeat
            ModalDialog(nil, ItemHit);                                            {IM I-415}

            case ItemHit of
                1: { OK button hit -- save resources }
                    begin
                        getDItem(theDialog, 3, itemType, itemHandle, dispRect);
                        GetIText(Handle(itemHandle), NextLaunch);
                        ResHandle2 := GetResource('STR ', 500);
                        RmveResource(ResHandle2);
                        UpdateResFile(CurrentResFile);
                        AddResource(Handle(NewString(NextLaunch)), 'STR ', 500, 'Next Launch');

                        getDItem(theDialog, 4, itemType, itemHandle, dispRect);
                        GetIText(Handle(itemHandle), PathAndLogfile);
                        ResHandle2 := GetResource('STR ', 501);
                        RmveResource(ResHandle2);
                        UpdateResFile(CurrentResFile);
                        AddResource(Handle(NewString(PathAndLogfile)), 'STR ', 501, 'Path:Logfile');

                        getDItem(theDialog, 5, itemType, itemHandle, dispRect);
                        GetIText(Handle(itemHandle), PathAndIntro);
                        ResHandle2 := GetResource('STR ', 502);
                        RmveResource(ResHandle2);
                        UpdateResFile(CurrentResFile);
                        AddResource(Handle(NewString(PathAndIntro)), 'STR ', 502, 'Path:Intro');

                        getDItem(theDialog, 6, itemType, itemHandle, dispRect);
                        GetIText(Handle(itemHandle), PathAndStep);
                        ResHandle2 := GetResource('STR ', 503);
                        RmveResource(ResHandle2);
                        UpdateResFile(CurrentResFile);
                        AddResource(Handle(NewString(PathAndStep)), 'STR ', 503, 'Path:Stepfile');

                        getDItem(theDialog, 7, itemType, itemHandle, dispRect);
                        GetIText(Handle(itemHandle), OmitFile);
                        ResHandle2 := GetResource('STR ', 504);
                        RmveResource(ResHandle2);
                        UpdateResFile(CurrentResFile);
                        AddResource(Handle(NewString(OmitFile)), 'STR ', 504, 'Path:Omitfile');

                        getDItem(theDialog, 8, itemType, itemHandle, dispRect);
                        GetIText(Handle(itemHandle), TallyData);
                        ResHandle2 := GetResource('STR ', 505);
                        RmveResource(ResHandle2);
                        UpdateResFile(CurrentResFile);
                        AddResource(Handle(NewString(TallyData)), 'STR ', 505, 'Path:Datafile');

                    end;        {    case ItemHit of 1    }

                2:
                    ; { Cancel button hit—do nothing    }

                otherwise
                    ;    {    do nothing    }

            end;
        until (ItemHit = 1) or (ItemHit = 2);
        DisposDialog(theDialog)
    end;

{ ------------------------------------------------------ }

    procedure GetStoredData;

        var
            Section, Day, DataRef: integer;
            WhenStored: DateTimeRec;
            StoredSecs, TempSecs, LastSession, logicalEOF: longint;
            Temp: char;
            TempString: str255;

    begin
        LastSession := 0;
        for Section := 1 to 255 do
            for Day := 1 to 10 do
                StoredCount[Section, Day] := 0;

        Err := FSOpen(TallyData, vRefNum, DataRef);
        if Err = NoErr then
            Err := GetEOF(DataRef, logicalEOF);
        TheCursor := 128;
        Increment := 9;
        InitCursor;
        Section := 1;
        if (logicalEOF > 0) & (Err = NoErr) then
            begin
                SkipBlanks(DataRef);
                Err := ReadLine(DataRef, TempString);
                StringToNum(TempString, LastSession);
                SkipBlanks(DataRef);
                while (not AtEOF(DataRef)) & (Section < 256) & (Err = NoErr) do
                    begin
                        if Increment > 8 then
                            RotateCursorBall
                        else
                            Increment := Increment + 1;
                        Section := ReadData(DataRef);
                        if (Section > 0) and (Section < 256) then
                            for Day := 1 to 10 do
                                StoredCount[Section, Day] := ReadData(DataRef);
                    end;        {    while (not AtEOF(DataRef)) and (Section < 256)    }
                Err := FSClose(DataRef);
            end;
        if LastSession <> 0 then
            begin
                Secs2Date(LastSession, TempTime);            {    Get the time at 00:00:00    }
                with TempTime do
                    begin
                        Hour := 0;
                        Minute := 0;
                        Second := 0;
                    end;        {    with TempTime    }
                Date2Secs(TempTime, LastSession);            {    We now have the very beginning of the day    }

                Secs2Date(NowSecs, TempTime);                    {    Get the time at 00:00:00    }
                with TempTime do
                    begin
                        Hour := 0;
                        Minute := 0;
                        Second := 0;
                    end;
                Date2Secs(TempTime, TempSecs);                {    We now have the very beginning of the day    }

                Adjust := (TempSecs - LastSession) div DAYSECS;

            end        {    if LastSession <> 0    }
        else
            Adjust := 0;
    end;

{ ------------------------------------------------------ }

    procedure StoreCounts;

        var
            Section, Day, DataRef: integer;

    begin
        Err := FSDelete(TallyData, vRefNum);
        MakeTextFile(TallyData);
        Err := FSOpen(TallyData, vRefNum, DataRef);
        Err := WrLn(DataRef, stringof(NowSecs : 1));
        for Section := 1 to 255 do
            begin
                if Increment > 2 then
                    RotateCursorBall
                else
                    Increment := Increment + 1;
                if (SectionName[Section] <> '') and (not OmitSection[Section]) then
                    begin
                        Err := Wr(DataRef, concat(stringof(Section : 1), chr(9)));
                        for Day := 1 to 10 do
                            if Day < 10 then
                                Err := Wr(DataRef, concat(stringof(SectionCount[Section, Day] : 1), chr(9)))
                            else
                                Err := WrLn(DataRef, stringof(SectionCount[Section, Day] : 1));
                    end;
            end;
        Err := FSClose(DataRef)
    end;

{ ------------------------------------------------------ }

    procedure ReadOmits;

        var
            OmitRefNum, OmitCount: integer;
            logicalEOF, currPos: longint;
            OmitLine: STR255;
            SectNo: longint;

    begin
        for OmitCount := 1 to 255 do
            OmitSection[OmitCount] := false;
        if OmitFile <> '' then
            begin
                Err := FSOpen(OmitFile, vRefNum, OmitRefNum);
                if Err = noErr then
                    Err := GetEOF(OmitRefNum, logicalEOF);
                if (Err = noErr) then
                    begin
                        Err := GetFPos(OmitRefNum, currPos);
                        while (currPos < logicalEOF) do
                            begin
                                Err := ReadLine(OmitRefNum, OmitLine);
                                StringToNum(OmitLine, SectNo);
                                if (SectNo > 0) and (SectNo < 256) then
                                    OmitSection[SectNo] := true;
                                Err := GetFPos(OmitRefNum, currPos)
                            end;        {    while (currPos < logicalEOF)        }
                        Err := FSClose(OmitRefNum)
                    end        {    if (Err = noErr)        }
            end        {    if OmitFile <> ''        }
    end;

{ ------------------------------------------------------ }

begin
    CurrentResFile := CurResFile;
    PathAndLogfile := GetString(501)^^;
    PathAndIntro := GetString(502)^^;
    PathAndStep := GetString(503)^^;
    OmitFile := GetString(504)^^;
    TallyData := GetString(505)^^;
    if Button then
        HandleDialog        { If user is holding down the mouse button, reconfigure and end            }
    else
        begin
            HelloTabby;    { find out what's next on the launchpad }
            DialogPointer := GetNewDialog(1001, nil, POINTER(-1));
            paramText(VERSION, '', '', '');
            SetPort(DialogPointer);
            forecolor(RedColor);
            TextSize(9);
            TextFont(Geneva);
            DrawDialog(DialogPointer);
            ReadConfig;
            ReadMESSAGES;
            GetDateTime(NowSecs);                        {    How many seconds now?    }
            Secs2Date(NowSecs, NowDateRec);
            GetStoredData;
            ReadOmits;
            ProcessMSGHDR;
            WriteReport;
            StoreCounts;

999:
            DisposDialog(DialogPointer);

            SetCursor(Arrow);
            if NextLaunch <> '' then
                LaunchNextAppl
        end    {    if  not Button        }
end.